home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / BUGFIXGP.ZIP / 75WPC2LB.SRC < prev    next >
Text File  |  1990-11-21  |  17KB  |  566 lines
  1. ;\|
  2. ;75WPC2LB.SRC     Translated from 75WPC2LB.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;START    04:15:36 PM  21/ 6/90   |
  4. RECALLSX:
  5. define(Z30|A|30||)
  6. define(YES.NO|A|1||)
  7. define(WAIT|N|3||)
  8. define(MEM_AD|A|22||)
  9. define(CHK_FLD|N|8||)
  10. define(NUM_N|N|2||)
  11. define(NUM|A|2||)
  12. define(DATE_A|A|8||)
  13. define(DATE_B|A|10||)
  14. define(TO_DATE|S|8||)
  15. define(SENT_DATE|S|8||)
  16. define(CHK_DATE|S|8||)
  17. define(PUNC2|N|2||)
  18. define(CH_NAME|A|15||)
  19. define(HIS|A|3||)
  20. define(CLIN_DAY|A|25||)
  21. define(CLIN_TIME|A|10||)
  22. define(CNTR|N|2||)
  23. define(FLAG|A|1||)
  24. define(AMOUNTX|N|4||)
  25. define(S10|A|10||)
  26. define(DATECOD|S|8||)
  27. define(CODER|A|5||)
  28. define(C30|A|30||)
  29. define(TM|A|27||4)
  30. define(A30|A|30||)
  31. define(CHOICE|N|1||)
  32. define(TDND|S|8||)
  33. define(DATERP|S|8||)
  34. define(B30|A|30||)
  35. define(S1|A|1||)
  36. define(TD|S|8||)
  37. define(A8|A|8||)
  38. define(B8|A|8||)
  39. define(YES.NO|A|1||)
  40. define(N5|N|5||)
  41. define(D1|A|1||)
  42. define(NY|A|1||)
  43. define(CODEX1|S|8||)
  44. define(CTR|N|2||)
  45. define(DATEN|N|2||)
  46. define(DATEX|S|8||)
  47. define(ARRAY1|A|30||3)
  48. define(ARRAY2|A|22||3)
  49. define(ARRAY3|A|22||3)
  50. define(ARRAY4|A|4||3)
  51. define(ARRAY5|S|8||3)
  52. define(TIT|A|4||)
  53. define(PATIENT1A|A|30||)
  54. define(PUNC1|N|2||)
  55. define(N.2.0.P|N|2||)
  56. define(P.2.0.1|N|2||)
  57. define(P.2.0.2|N|2||)
  58. define(PATIENT2|A|30||)
  59. define(P.2.0.3|N|2||)
  60. define(RECTYPE1|A|4||)
  61. define(RECTYPE2|A|4||)
  62. define(PATIENT1|A|30||)
  63. define(DOB1|D|10||)
  64. define(DOB2|D|10||)
  65. trap(q|g|exit4)
  66. STARTREC:
  67. open(PATIENT||0|FILE_LOCK)
  68. open(GPSETUP||0|)
  69. find(B|HEADING||)
  70. D1 = ("")
  71. date(TD|G)
  72. YES.NO = ("")
  73. DATEX = (0)
  74. CODEX1 = (0)
  75. NY = ("")
  76. trap(I|G|PRINTSTOP)
  77. trap(S|I)
  78. trap(D|I)
  79. trap(F|I)
  80. trap(R|I)
  81. trap(B|I)
  82. trap(G|I)
  83. trap(H|S|HELP)
  84. trap(M|I)
  85. trap(N|I)
  86. trap(Q|G|MENU)
  87. trap(J|G|LASTSEEN)
  88. goto LASTSEEN
  89. mount(RECALLS|S)
  90. enter(RECTYPE1||||Y|Y|N|||N)
  91. enter(RECTYPE2||||Y|Y|N|||N)
  92. enter(CTR|"123456789"|||N|Y|N|||N)
  93. enter(CODEX1|||RECALLSX|N|Y|N|||N)
  94. DATEXX:
  95. NY = ("")
  96. enter(YES.NO|"YN"|||Y|Y|N|||N)
  97. CODEX1:
  98. RECSTART:
  99. COD.PAT.NAME = ("A")
  100. find(G|COD.PAT.NAME|EXIT|N)
  101. RECTEST:
  102. if COD[CTR] = ("HYS") goto NEXTRECALL
  103. if COD[CTR] = ("VIR") goto NEXTRECALL
  104. if COD[CTR] = ("REF") goto NEXTRECALL
  105. if COD[CTR] = ("MOV") goto NEXTRECALL
  106. if RECTYPE1 <> ("") then if RECTYPE1 > (COD[CTR]) goto NEXTRECALL
  107. if RECTYPE2 <> ("") then if RECTYPE2 < (COD[CTR]) goto NEXTRECALL
  108. if COD.D[CTR] > (CODEX1) goto NEXTRECALL
  109. if COD.D[CTR] = (0) goto NEXTRECALL
  110. RECORD.NUMBER = (COD.REF)
  111. DATECOD = (COD.D[CTR])
  112. CODER = (COD[CTR])
  113. find(M|RECORD.NUMBER|EXIT|)
  114. DATERP = (COD.D[CTR])
  115. if NY = ("") do
  116. {
  117. gosub PRINTRECAL
  118. }
  119. else
  120. {
  121. gosub RECLABPRIN
  122. }
  123. NEXTRECALL:
  124. find(N|RECALLS|EXITX|)
  125. goto RECTEST
  126. MOUNTRECAL:
  127. mount(RPLABELS|R|P)
  128. pchr(P|10)
  129. pchr(P|11)
  130. pchr(P|4)
  131. pchr(P|1)
  132. pset(132|66|60)
  133. trap(I|G|PRINTSTOP)
  134. trap(P|S|RECHEAD)
  135. AMOUNTX = (0)
  136. gosub RECHEAD
  137. ret
  138. PRINTRECAL:
  139. pfmt(18|||N|N|)
  140. AMOUNTX = (AMOUNTX+1)
  141. DATECOD = (0)
  142. CODER = ("")
  143. ret
  144. RECHEAD:
  145. pfmt(16|||N|N|)
  146. pfmt(17|||N|N|)
  147. ret
  148. RECALLS:
  149. trap(P|D)
  150. ptof
  151. if D1 = ("X") then goto RECALLSX
  152. if YES.NO = ("Y") do
  153. {
  154. gosub RECLABS
  155. }
  156. else
  157. {
  158. goto RECALLSX
  159. }
  160. goto RECSTART
  161. TOPOF:
  162. ptof
  163. ret
  164. RECLABS:
  165. NY = ("X")
  166. trap(P|D)
  167. trap(I|S|PRINTSTOP)
  168. pchr(P|4)
  169. mount(NEW|R|P)
  170. pset(50|18|18)
  171. D1 = ("X")
  172. ret
  173. PRINT_LAB:
  174. pblnk(4)
  175. pfmt(1|||N|N|)
  176. pblnk(2)
  177. pfmt(2|||N|N|)
  178. pblnk(2)
  179. pfmt(3|||N|N|)
  180. pblnk(4)
  181. if FLAG = ("X") goto EXIT
  182. ret
  183. CL_ARRAY:
  184. clrmem(ARRAY1|3)
  185. clrmem(ARRAY2|3)
  186. clrmem(ARRAY3|3)
  187. clrmem(ARRAY4|3)
  188. clrmem(ARRAY5|3)
  189. ret
  190. RECLABPRIN:
  191. gosub SEXIST
  192. gosub NEWX
  193. NY = ("X")
  194. DATECOD = (0)
  195. CODER = ("")
  196. CNTR = (CNTR+1)
  197. ARRAY1[CNTR] = (Z30)
  198. ARRAY2[CNTR] = (ADDRESS1)
  199. ARRAY3[CNTR] = (AREA)
  200. ARRAY4[CNTR] = (COD[CTR])
  201. ARRAY5[CNTR] = (COD.D[CTR])
  202. if CNTR = (3) gosub PRINT_LAB
  203. ret
  204. EXITX:
  205. if NY <> ("") do
  206. {
  207. CNTR = (2)
  208. FLAG = ("X")
  209. gosub RECLABPRIN
  210. }
  211. goto RECALLS
  212. REPONLY:
  213. run("REPONLY")
  214. SEXIST:
  215. if SEX = ("M") then TIT = ("Mr.")
  216. if SEX = ("F") do
  217. {
  218. if MARITAL.STATUS = ("M") do
  219. {
  220. TIT = ("Mrs.")
  221. }
  222. else
  223. {
  224. TIT = ("Ms.")
  225. }
  226. }
  227. if SEX = ("") then TIT = ("Ms.")
  228. trim(TIT|T)
  229. ret
  230. NEWX:
  231. NY = (" ")
  232. PATIENT1A = (PATIENT.NAME)
  233. trim(PATIENT1A|T)
  234. PUNC1 =loc(","|PATIENT1A|1||27)
  235. N.2.0.P =siz(A|PATIENT.NAME)
  236. P.2.0.1 = (PUNC1-1)
  237. PATIENT2 =mid(PATIENT.NAME|1|P.2.0.1|)
  238. P.2.0.2 = (PUNC1+2)
  239. P.2.0.3 = (N.2.0.P-P.2.0.2+1)
  240. PATIENT1 =mid(PATIENT1A|P.2.0.2|P.2.0.3|)
  241. trim(PATIENT1|T)
  242. trim(PATIENT2|T)
  243. Z30 = (TIT+PATIENT1+NY+PATIENT2)
  244. ret
  245. CLEARALL:
  246. clr(PATIENT|B)
  247. clr(RECALLS|B)
  248. S1 = ("")
  249. DATEX = (0)
  250. YES.NO = ("")
  251. ret
  252. EXIT:
  253. run("75WPC2")
  254. EXIT1:
  255. run("75WPC2")
  256. PRINTSTOP:
  257. pon(S)
  258. clrlne(1|25)
  259. pmsg("CONTINUE ? (Y/N):"|30|12|N|N|S|)
  260. enter(YES.NO|"YN"||PRINTSTOP|Y|Y|N|48|12|N)
  261. if YES.NO <> ("Y") then run("recmenu")
  262. pon(P)
  263. ret
  264. MENU:
  265. TM[1] = (" 1 - EXIT             01011")
  266. menu(1|20|2|23|0|TM|CHOICE|1|22|MENU||"-------RECALLS--------"|N)
  267. on(CHOICE|G|EXIT1|MENU)
  268. TRACE:
  269. break
  270. ret
  271. FILE_LOCK:
  272. pmsg("FILE PATIENT AND/OR RECALLS IS IN USE - EXIT"|20|24|Y|N|S|)
  273. clrlne(1|24)
  274. run("recmenu")
  275. HELP:
  276. saves(1)
  277. window(1|23|22|78)
  278. pmsg("                                    SMEAR RECALLS"|1|1|N|Y|S|)
  279. pmsg("                                    ============="|1|2|N|Y|S|)
  280. pmsg("1.USE UPDATE PROGRAM AND MAKE SURE ALL WOMEN BETWEEN 33 AND 65 ARE ENTERED"|1|3|N|Y|S|)
  281. pmsg("2.ALL THESE WOMEN MUST HAVE A RECALL DATE."|1|4|N|Y|S|)
  282. pmsg("3.RUN REPORT ONLY TO GET LATEST UPDATE ON TOTAL AT-RISK GROUP"|1|5|N|Y|S|)
  283. pmsg("4.RECALL EVERY MONTH ON THE 16th + A DAY OR TWO"|1|6|N|Y||)
  284. pmsg("5.CHECK OFF AGAINST RECALL LIST. ALL NON-ATTENDERS WILL BE ASKED AGAIN"|1|7|N|Y|S|)
  285. pmsg("6.NON-ATTENDERS WILL BE THOSE WHO ARE MORE THAN ONE MONTH BEHIND"|1|8|N|Y||)
  286. pmsg(""|1|9|N|Y|S|)
  287. pmsg("                                    CODES"|1|10|N|Y|S|)
  288. pmsg("                                    ====="|1|11|N|Y|S|)
  289. pmsg("CODE 1 = SMEARS"|1|12|N|Y|S|)
  290. pmsg("CODE 2 = CONTRACEPTION"|1|13|N|Y|S|)
  291. pmsg("CODE 3 = IMMUNISATION"|1|14|N|Y|S|)
  292. pmsg("CODE 4 = DIABETES"|1|15|N|Y|S|)
  293. pmsg("CODE 5 = EPILEPSY"|1|16|N|Y|S|)
  294. pmsg("CODE 6 = THYROID"|1|17|N|Y|S|)
  295. pmsg("CODE 7 = ANGINA AND HEART DISEASE"|1|18|N|Y|S|)
  296. pmsg("CODE 8 = ASTHMA"|1|19|N|Y|S|)
  297. pmsg("CODE 9 = BP"|1|20|N|Y|S|)
  298. pmsg(""|1|21|Y|N|S|)
  299. redsp(1)
  300. ret
  301. LASTSEEN:
  302. trap(I|S|PRINTSTOP)
  303. trap(J|G|STARTREC)
  304. mount(LABS|S)
  305. MEM_AD = ("1")
  306. enter(MEM_AD||||Y|N|N|||N)
  307. enter(DOB1||||N|N|N|||N)
  308. enter(DOB2||||N|N|N|||N)
  309. SENT_DATE = (TD)
  310. enter(YES.NO|"YN"|||Y|Y|N|||N)
  311. if YES.NO <> ("Y") goto LASTSEEN
  312. gosub RECLABS
  313. ADDRESS1 = (MEM_AD)
  314. find(G|ADDRESS1|EXIT|)
  315. TEST_SEEN:
  316. if DATE.OF.BIRTH < (DOB1) goto NEXT_SEEN
  317. if DATE.OF.BIRTH > (DOB2) goto NEXT_SEEN
  318. gosub PRINT_SEEN
  319. NEXT_SEEN:
  320. find(N|PATIENT|EXITXX|)
  321. pmsg(RECORD.NUMBER|1|1|N|N|S|)
  322. goto TEST_SEEN
  323. PRINT_SEEN:
  324. gosub SEXIST
  325. gosub NEWX
  326. gosub SEEN_PRINT
  327. ret
  328. SEEN_PRINT:
  329. WAIT = (WAIT+1)
  330. if WAIT = (195) do
  331. {
  332. pmsg(WAIT;" PRINTED - CHANGE CARDS AND PRESS RET...";RECORD.NUMBER;"  next"|10|20|Y|N|S|)
  333. WAIT = (0)
  334. }
  335. pblnk(6)
  336. pfmt(1|||N|N|)
  337. pblnk(2)
  338. pfmt(2|||N|N|)
  339. pblnk(2)
  340. pfmt(3|||N|N|)
  341. pblnk(4)
  342. pfmt(4|||N|N|)
  343. ret
  344. DAT_TEST:
  345. goto PRINT_SEEN
  346. EXITXX:
  347. goto EXIT
  348. exit4:
  349. run("recmenu")
  350. \R RPLABELS
  351. &                                      &                                        &
  352. &                                      &                                        &
  353. &                                      &                                        &
  354.  
  355. &    &                                 &    &                                   &    &
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.       &
  363.            &
  364.               &
  365.       &
  366. PATIENT                - RECALL REPORT- &                                        CODE (& )
  367. ------------------------------------------------------------------------------------------
  368. &                             &                     &                      (&    )&         &     [&]
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398.  
  399. \
  400. ARRAY1[1]
  401. ARRAY1[2]
  402. ARRAY1[3]
  403. ARRAY2[1]
  404. ARRAY2[2]
  405. ARRAY2[3]
  406. ARRAY3[1]
  407. ARRAY3[2]
  408. ARRAY3[3]
  409. ARRAY4[1]
  410. ARRAY5[1]
  411. ARRAY4[2]
  412. ARRAY5[2]
  413. ARRAY4[3]
  414. ARRAY5[3]
  415. Z30
  416. ADDRESS1
  417. AREA
  418. DATERP
  419. TD
  420. CTR
  421. PATIENT.NAME
  422. ADDRESS1
  423. AREA
  424. CODER
  425. DATECOD
  426. AMOUNTX
  427. DOCTOR
  428. \
  429. \SSRECALLS 
  430.                                                                                                 
  431.                                                                                                 
  432.                                                                                                 
  433.                                                   YOU MAY JUMP TO PRINT "NOT SEEN" LABELS       
  434.                                                                                                 
  435.       This will recall all recall code 1 except "HYS;VIR;MOV;REF;ETC"                           
  436.                                                                                                 
  437.    RECALLS                                                       ╔══════════════════════════════
  438. ══════════╗                                      ║                                        ║     
  439.                                  ║  From Code: t t t t  to  Code: t t t t         ║                     
  440.                  ║                                        ║                                     
  441.  ║ Recall code:[ t t]                       ║                                      ║              
  442.                           ║                                      ║ Up to Date: t t t t t t t t          
  443. Labels?: t ║                                      ╚════════════════════════════════════════╝     
  444.                                F1 - Help   "Printer on for labels" Esc - Exit                   
  445.                                                                                                 
  446.                                                                                                 
  447.                                                                                                 
  448.                                                                                                 
  449.                                                                                                 
  450. \
  451. RECTYPE1            4 A 3112
  452. RECTYPE2            4 A 4612
  453. CTR                 2 N 3314
  454. CODEX1              8 S 3116
  455. YES.NO              1 A 5716
  456. \
  457. \STNOTE    
  458.                          RECALLS - WHAT TO DO
  459.                          ====================
  460.  
  461. 1. TO TAG ALL POTENTIAL RECALLS ANSWER RUN RECALLS AT RISK FROM MAIN MENU.
  462.  
  463.   (THIS WILL TAG A GIVEN AGE GROUP WITH CODE <****>)
  464.  
  465. 2. TO UPDATE THE <****> USE EASY SMEAR /IMMUNISATION UPDATE PROGRAM.
  466.  
  467. 3. IF YOU ANSWER NO TO REPORT ONLY YOU WILL PRINT A LIST OF OUTSTANDING
  468.    RECALLS WITH OR WITHOUT LABELS.
  469.  
  470. 6. PRINT OUT THESE AND SEND TO PATIENTS.
  471.  
  472. 7. UPDATE  RESULTS USING EASY RECALL MAINTENANCE
  473.  
  474.         NOTE: THIS PROGRAM WILL ALWAYS PRINT OUT "ALL" OUTSTANDING RECALLS.
  475.  
  476.                           ========================
  477.  
  478.  
  479.  
  480.  
  481.  
  482. \
  483. \
  484. \SSLABS    
  485.                                                                                                 
  486.                                                                                                 
  487.                                                                                                 
  488.                                                                                                 
  489.                                                                                                 
  490.               PRINTS ADDRESSES ON CARDS FOR 75 WELL PERSON CLINIC                               
  491.    ╔═══════════════════════════════════════╗                                       ║ From Addres
  492. s: p p p p p p p p p p p p p p p p p p p p p p   ║                                       ║ From D.o.b  : p p p p p p p p p p eg 
  493. 01/01/1880 ║                                       ║ To D.o.b.   : p p p p p p p p p p eg 01/04/1914 ║    
  494.                                    ║     CONTINUE: p Y/N                    ║                    
  495.                    ╚═══════════════════════════════════════╝                                    
  496.     REQUIRES CARDS IN PRINTER REVERSE SIDE                                                 Esc -
  497.  Exit or stop Print                                                                             
  498.                                                                                                 
  499.                                                                                                 
  500.                                                                                                 
  501.                                                                                                 
  502.                                                                                                 
  503.                                                                                                 
  504.                                                                                                 
  505. \
  506. MEM_AD             22 A 35 9
  507. DOB1               10 D 3510
  508. DOB2               10 D 3511
  509. YES.NO              1 A 3512
  510. \
  511. \R NEW     
  512.         &
  513.            &
  514.                &
  515. -&
  516.  
  517.  
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  
  534.  
  535.  
  536.  
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  
  553.  
  554.  
  555.  
  556.  
  557.  
  558.  
  559.  
  560. \
  561. Z30
  562. ADDRESS1
  563. AREA
  564. RECORD.NUMBER
  565. \
  566.